{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS -Wall #-}

--------------------------------------------------------------------------------
-- |
-- Module      :  Majalan.Base.Internal.PitchUtils
-- Copyright   :  (c) Stephen Tetley 2014
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  unstable
-- Portability :  GHC
--
-- Pitch helpers - Z12 numeric type, MIDI pitch, 
--
-- Import directly if needed.
--
--------------------------------------------------------------------------------

module Majalan.Base.Internal.PitchUtils
  ( 

    Z12
  , Modulo12(..)

  , MidiPitch
  , Interval

  , Octave
  , octaveToHertz

  ) where


import Majalan.Base.Internal.Base

import Data.AffineSpace                         -- package: vector-space
import Data.VectorSpace





newtype Z12 = Z12 Int
  deriving (Enum,Eq,Integral,Ord,Real)

instance Show Z12 where
  showsPrec p (Z12 i) = showsPrec p i

instance Read Z12 where
  readsPrec p s       = map fn $ readsPrec p s
    where
      fn :: (Int,String) -> (Z12,String)
      fn (i,ss) = (Z12 i, ss)


liftUZ12 :: (Int -> Int) -> Z12 -> Z12
liftUZ12 op (Z12 a) = Z12 $ mod (op a) 12

liftBZ12 :: (Int -> Int -> Int) -> Z12 -> Z12 -> Z12
liftBZ12 op (Z12 a) (Z12 b) = Z12 $ mod (a `op` b) 12

instance Num Z12 where
  (+) = liftBZ12 (+)
  (-) = liftBZ12 (-)
  (*) = liftBZ12 (*)
  negate        = liftUZ12 negate
  fromInteger i = Z12 $ (fromInteger i) `mod` 12
  signum _      = error "Modular numbers are not signed"
  abs _         = error "Modular numbers are not signed"



instance AdditiveGroup Z12 where
  zeroV = 0
  (^+^) = (+)
  negateV v = 0 - v


--------------------------------------------------------------------------------

class Modulo12 a where
  fromZ12 :: Z12 -> a
  toZ12   :: a  -> Z12


instance Modulo12 Int where
  fromZ12 (Z12 i) = i
  toZ12 i = Z12 $ mod i 12

instance Modulo12 Integer where
  fromZ12 (Z12 i) = fromIntegral i
  toZ12 i         = Z12 $ fromIntegral $ mod i 12




--------------------------------------------------------------------------------
-- Midi Pitch



newtype MidiPitch = MidiPitch { getMidiPitch :: Int }
  deriving (Enum,Eq,Ord,Num,Real,Integral)

instance Show MidiPitch where
  showsPrec p d = showsPrec p (getMidiPitch d)


instance AffineSpace MidiPitch where
  type Diff MidiPitch = Interval
  (.-.) a b = Interval $ getMidiPitch a - getMidiPitch b
  (.+^) a b = MidiPitch $ getMidiPitch a + getInterval b




--------------------------------------------------------------------------------
-- Intervals


-- | Interval is just a count of a steps (semitones for ET12).
--
newtype Interval = Interval { getInterval :: Int }
  deriving (Enum,Eq,Ord,Integral,Num,Real)

instance Show Interval where
  showsPrec p d = showsPrec p (getInterval d)

instance AdditiveGroup Interval where
  zeroV   = 0
  negateV = negate
  (^+^)   = (+)




--------------------------------------------------------------------------------
-- Octave representation

newtype Octave = Octave { getOctave :: Double }
  deriving (Eq,Ord,Num,Fractional,Real,RealFrac)

instance Show Octave where
  showsPrec p d = showsPrec p $ getOctave d


-- | Converting to @octave@ representation then calling 
-- @octaveToHertz@ is potentailly the easiest way to implement the
-- @hertz@ method from @TPitch@.
-- 
octaveToHertz :: HzPitch -> Octave -> Decimal
octaveToHertz gblhz x = realToFrac $ (\tv -> tv * 2.0 ** (x1 - 8.75)) tuninghz
  where
    x1       = getOctave x
    tuninghz = realToFrac gblhz
